home *** CD-ROM | disk | FTP | other *** search
/ Collection of Tools & Utilities / Collection of Tools and Utilities.iso / clipper / nfsrc21.zip / TBWHILE.PRG < prev    next >
Text File  |  1991-09-28  |  16KB  |  501 lines
  1. /*
  2.  * File......: TBWHILE.PRG
  3.  * Author....: Jim Orlowski
  4.  * Date......: $Date:   28 Sep 1991 02:56:56  $
  5.  * Revision..: $Revision:   1.4  $
  6.  * Log file..: $Logfile:   E:/nanfor/src/tbwhile.prv  $
  7.  * 
  8.  * This is an original work by Jim Orlowski and is placed in the
  9.  * public domain.
  10.  *
  11.  * Modification history:
  12.  * ---------------------
  13.  *
  14.  * $Log:   E:/nanfor/src/tbwhile.prv  $
  15.  * 
  16.  *    Rev 1.4   28 Sep 1991 02:56:56   GLENN
  17.  * Moved Jim's "Tricks used" comment out of the file header and
  18.  * into the source code area.
  19.  * 
  20.  *    Rev 1.3   28 Sep 1991 02:52:22   GLENN
  21.  * Jim's modifications:
  22.  * 
  23.  *  1.  Changed SAVESCREEN() and RESTSCREEN to use MaxRow(), MaxCol()
  24.  *      instead of 24,79
  25.  * 
  26.  *  2.  Added Nantucket's cleaner code for:
  27.  *        - Cleaned up logic around line 334 while loop section
  28.  *        - Added refreshCurrent and another stabilize around line 349
  29.  *        - TbSkipWhile was redone 
  30.  *             Note: Leo's line was changed to:
  31.  *                 ELSEIF ( n > 0 .AND. RECNO() <> LASTREC() + 1)
  32.  * 
  33.  *  3.  Added DispBegin() and DispEnd() around both Stabilize sections
  34.  * 
  35.  * 
  36.  * 
  37.  * 
  38.  *    Rev 1.2   15 Aug 1991 23:04:20   GLENN
  39.  * Forest Belt proofread/edited/cleaned up doc
  40.  * 
  41.  *    Rev 1.1   14 Jun 1991 19:53:08   GLENN
  42.  * Minor edit to file header
  43.  * 
  44.  *    Rev 1.0   01 Apr 1991 01:02:22   GLENN
  45.  * Nanforum Toolkit
  46.  *
  47.  */
  48.  
  49.  
  50.  
  51. /* The tricks are: 
  52.  *
  53.  * 1. Setting up functions for goTop() and goBottom() so that you can 
  54.  *    quickly move to the right record when the user presses the 
  55.  *    Ctrl-PgUp ( goTop() ) and Ctrl-PgDn ( goBottom() ) keys.
  56.  *
  57.  * 2. Passing and evaluating the block for the TbSkipWhil().
  58.  */
  59.  
  60.  
  61. #command DEFAULT <param> TO <val> [, <paramn> TO <valn> ];
  62. => ;
  63.          <param> := IIF(<param> = NIL, <val>, <param> ) ;
  64.          [; <paramn> := IIF(<paramn> = NIL, <valn>, <paramn> ) ]
  65. #include "inkey.ch"
  66.  
  67.  
  68. #ifdef FT_TEST
  69.  
  70.   /*
  71.    *   THIS DEMO SHOWS TBNAMES.DBF CONSISTING OF LAST, FIRST, ADDR, CITY,
  72.    *   STATE, ZIP WITH ACTIVE INDEX ON LAST + FIRST.  IT SHOWS LAST NAME,
  73.    *   FIRST NAME, CITY ONLY FOR THOSE LAST NAMES THAT BEGIN WITH LETTER
  74.    *   THAT YOU INPUT FOR THE CKEY GET.
  75.    *
  76.    *   TBNAMES.DBF/.NTX ARE AUTOMATICALLY CREATED BY THIS TEST PROGRAM
  77.    */
  78.  
  79.   #INCLUDE "SETCURS.CH"
  80.  
  81.   FUNCTION TBWHILE()
  82.      LOCAL aFields := {}, cKey := "O", cOldColor
  83.      LOCAL nFreeze := 1, lSaveScrn := .t., nRecSel
  84.      LOCAL cColorList := "N/W, N/BG, B/W, B/BG, B/W, B/BG, R/W, B/R"
  85.      LOCAL cColorShad := "N/N"
  86.      FIELD last, first
  87.      MEMVAR GetList
  88.  
  89.      IF ! FILE( "TBNAMES.DBF" )
  90.         MAKE_DBF()
  91.      ENDIF
  92.  
  93.      USE TBNames
  94.  
  95.      IF ! FILE( "TBNAMES.NTX" )
  96.         INDEX ON last + first TO TBNAMES
  97.      ENDIF
  98.  
  99.      SET INDEX TO TBNAMES
  100.  
  101.      * Pass Heading as character and Field as Block including Alias
  102.      * To eliminate the need to use FIELDWBLOCK() function in FT_BRWSWHL()
  103.  
  104.      AADD(aFields, {"Last Name" , {||TBNames->Last}  } )
  105.      AADD(aFields, {"First Name", {||TBNames->First} } )
  106.      AADD(aFields, {"City"      , {||TBNames->City}  } )
  107.  
  108.      cOldColor := SetColor("N/BG")
  109.      CLEAR SCREEN
  110.      @ 5,10 SAY "Enter First Letter Of Last Name:" GET cKey PICTURE "!"
  111.      READ
  112.  
  113.      * TBNames->Last = cKey is the Conditional Block passed to this function
  114.      * you can make it as complicated as you want, but you would then
  115.      * have to modify TBWhileSet() to find first and last records
  116.      * matching your key.
  117.      nRecSel := FT_BRWSWHL( aFields, {||TBNames->Last = cKey}, cKey, nFreeze,;
  118.         lSaveScrn, cColorList, cColorShad, 3, 6, MaxRow() - 2, MaxCol() - 6)
  119.      * Note you can use Compound Condition 
  120.      * such as cLast =: "Pierce            " and cFirst =: "Hawkeye  "
  121.      * by changing above block to:
  122.      *    {||TBNames->Last = cLast .AND. TBNames->First = cFirst}
  123.      * and setting cKey := cLast + cFirst
  124.  
  125.      ?
  126.      IF nRecSel == 0
  127.         ? "Sorry, NO Records Were Selected"
  128.      ELSE
  129.         ? "You Selected " + TBNames->Last +" "+ ;
  130.            TBNames->First +" "+ TBNames->City
  131.      ENDIF
  132.      ?
  133.  
  134.      WAIT
  135.      SetColor(cOldColor)
  136.      CLEAR SCREEN
  137.   RETURN nil
  138.  
  139.   STATIC FUNCTION make_dbf
  140.   LOCAL x, aData := {                                                               ;
  141.      { "SHAEFER","KATHRYN","415 WEST CITRUS ROAD #150","LOS ANGELES","CA","90030" },;
  142.      { "OLSON","JAMES","225 NORTH RANCH ROAD","LOS ANGELES","CA","90023"          },;
  143.      { "KAYBEE","JOHN","123 SANDS ROAD","CAMARILLO","CA","93010"                  },;
  144.      { "HERMAN","JIM","123 TOON PAGE ROAD","VENTURA","CA","93001"                 },;
  145.      { "BURNS","FRANK","123 VIRGINA STREET","OXNARD","CA","93030"                 },;
  146.      { "PIERCE","HAWKEYE","123 OLD TOWN ROAD","PORT MUGU","CA","93043"            },;
  147.      { "MORGAN","JESSICA","123 FRONTAGE ROAD","CAMARILLO","CA","93010"            },;
  148.      { "POTTER","ROBERT","123 FIR STREET","OXNARD","CA","93030"                   },;
  149.      { "WORTH","MARY","123-1/2 JOHNSON DRIVE","OXNARD","CA","93033"               },;
  150.      { "JOHNSON","SUSAN","123 QUEENS STREET","OXNARD","CA","93030"                },;
  151.      { "SAMSON","SAM","215 MAIN STREET","OXNARD","CA","93030"                     },;
  152.      { "NEWNAME","JAMES","215 MAIN STREET","LOS ANGELES","CA","90000"             },;
  153.      { "OLEANDAR","JILL","425 FLORAL PARK DRIVE","FLORAL PARK","NY","10093"       },;
  154.      { "SUGARMAN","CANDY","1541 SWEETHEART ROAD","HERSHEY","PA","10132"           } }
  155.  
  156.   DbCreate( "TBNAMES", { { "LAST ", "C", 18, 0, } ,;
  157.                          { "FIRST", "C",  9, 0, } ,;
  158.                          { "ADDR ", "C", 28, 0, } ,;
  159.                          { "CITY ", "C", 21, 0, } ,;
  160.                          { "STATE", "C",  2, 0, } ,;
  161.                          { "ZIP  ", "C",  9, 0, } } )
  162.   USE tbnames
  163.   FOR x := 1 TO Len( aData )
  164.      APPEND BLANK
  165.      Aeval( aData[x], {|e,n| FieldPut( n, e ) } )
  166.   NEXT
  167.   USE
  168.   RETURN NIL
  169.  
  170. #endif
  171.  
  172. /* ------------------------------------------------------------------- */
  173.  
  174. /*  $DOC$
  175.  *  $FUNCNAME$
  176.  *     FT_BRWSWHL()
  177.  *  $CATEGORY$
  178.  *     Menus/Prompts
  179.  *  $ONELINER$
  180.  *     Browse an indexed database limited to a while condition
  181.  *  $SYNTAX$
  182.  *     FT_BRWSWHL( <aFields>, <bWhileCond>, <cKey>,                  ;
  183.  *                 [ <nFreeze> ], [ <lSaveScrn> ], [ <cColorList> ], ;
  184.  *                 [ <cColorShadow> ], [ <nTop> ], [ <nLeft> ],      ;
  185.  *                 [ <nBottom> ], [ <nRight> ] -> nRecno
  186.  *  $ARGUMENTS$
  187.  *     <aFields> is array of field blocks of fields you want to display.
  188.  *        Example to set up last name and first name in array:
  189.  *        aFields := {}
  190.  *        AADD(aFields, {"Last Name" , {||Names->Last}  } )
  191.  *        AADD(aFields, {"First Name", {||Names->First} } )
  192.  *
  193.  *     <bWhileCond> is the limiting WHILE condition as a block.
  194.  *        Example 1: { ||Names->Last == "JONES" }
  195.  *        Example 2: { ||Names->Last == "JONES" .AND. Names->First == "A"  }
  196.  *
  197.  *     <cKey> is the key to find top condition of WHILE.  
  198.  *        cLast  := "JONES     "
  199.  *        cFirst := "A"
  200.  *        Example 1: cKey := cLast
  201.  *        Example 2: cKey := cLast + cFirst
  202.  *
  203.  *     <nFreeze> is number of fields to freeze in TBrowse.  Defaults
  204.  *     to 0 if not passed.
  205.  *
  206.  *     <lSaveScrn> is a logical indicating whether or not you want to
  207.  *     save the screen from the calling program.  Defaults to .T. if
  208.  *     not passed.
  209.  *
  210.  *     <cColorList> is a list of colors for the TBrowse columns.
  211.  *     The 1st color is used as SAY/TBrowse Background and the
  212.  *     3rd and 4th colors are used as part of column:defColor := {3, 4}
  213.  
  214.  *     Thus if you pass a cColorList, you MUST pass at least 4 colors.
  215.  *     Defaults to "N/W, N/BG, B/W, B/BG, B/W, B/BG, R/W, B/R" if not passed.
  216.  *
  217.  *     <cColorShad> is the color of the TBrowse box shadow.  Defaults
  218.  *     to "N/N" if not passed.
  219.  *
  220.  *     <nTop>, <nLeft>, <nBottom>, <nRight> are the coordinates of
  221.  *     the area to display the TBrowse in.  Defaults to 2, 2,
  222.  *     MAXROW() - 2, MAXCOL() - 2 with shadowe